{-# OPTIONS -Wall #-}


--------------------------------------------------------------------------------
-- |
-- Module      :  ZCSV.PrimLexer
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Lexer.
-- 
--------------------------------------------------------------------------------

module ZCSV.PrimLexer 
  ( 

    LineNum
  , ErrMsg
  , Tok(..)
  , tokLineNum
  , tokBody
  , lexer
  , lexerIO
  
  ) where


import ZCSV.Utils

import qualified Data.Text as T
import qualified Data.Text.IO as TIO

import Control.Applicative

type LineNum = Int
type ErrMsg = String


data Tok = Escaped      LineNum String
         | NonEscaped   LineNum String
         | ErrTok       LineNum ErrMsg String
         | EOL          LineNum
  deriving (Eq,Show)


tokLineNum :: Tok -> LineNum
tokLineNum (Escaped i _)       = i
tokLineNum (NonEscaped i _)    = i
tokLineNum (ErrTok i _ _ )     = i
tokLineNum (EOL i)             = i

tokBody :: Tok -> String
tokBody (Escaped _ s)          = s
tokBody (NonEscaped _ s)       = s
tokBody _                      = ""


lexerIO :: FilePath -> IO [Tok]
lexerIO path = lexer <$> TIO.readFile path


-- | Removes escaped char from input...
--
lexer :: T.Text -> [Tok]
lexer = start 1 . T.uncons
  where
     start i (Just (',',  inp)) = NonEscaped i "" : start i (T.uncons inp)
     start i (Just ('\n', inp)) = EOL i : start (i+1) (T.uncons inp)
     start i (Just ('"',  inp)) = escaped i i emptyH (T.uncons inp)
     start i (Just (c,    inp)) = nonescaped i (wrapH c) (T.uncons inp)
     start _ (Nothing)          = []


     escaped i j ac (Just ('"',  inp)) = case (T.uncons inp) of
        Just ('"', inp2)  -> escaped i j (ac `snocH` '"') (T.uncons inp2)
        Just (',', inp2)  -> Escaped i (ac $ []) : start j (T.uncons inp2)
        Just ('\n', inp2) -> Escaped i (ac $ []) : start (j+1) (T.uncons inp2)
        Just (_, _)       -> [makeErrTok i "Lexer Error - unescaped '\"'" (Just inp)]
        Nothing           -> [makeErrTok i "Lexer Error - EOF" Nothing]

     escaped i j ac (Just ('\n', inp)) = escaped i (j+1) (ac `snocH` '\n') (T.uncons inp)
     escaped i j ac (Just (c,    inp)) = escaped i j (ac `snocH` c) (T.uncons inp)
     escaped i _ _  Nothing            = [makeErrTok i "Lexer Error - EOF" Nothing]



     nonescaped i ac (Just (',',  inp)) = NonEscaped i (ac $ []) : start i (T.uncons inp)
     nonescaped i ac (Just ('\n', inp)) = NonEscaped i (ac $ []) : EOL i : start (i+1) (T.uncons inp)
     nonescaped i _  (Just ('"',  inp)) = [makeErrTok i "Lexer Error - unescaped '\"'" (Just inp)]
     nonescaped i ac (Just (c,    inp)) = nonescaped i (ac `snocH` c) (T.uncons inp)
     nonescaped i ac Nothing            = [NonEscaped i (ac $ [])]
     


makeErrTok :: LineNum -> ErrMsg -> Maybe T.Text -> Tok
makeErrTok i msg Nothing     = ErrTok i msg ""
makeErrTok i msg (Just rest) = ErrTok i msg (fn $ T.lines rest)
  where
    fn []    = ""
    fn (t:_) = T.unpack t



